SCP - Centrality

1 Carga de librerías

if (!(require(DT)))
  install.packages("DT")
library(DT)

if (!require(readxl))
  install.packages("readxl")
library(readxl)

# Rfast para matriz de varianza combinada
if (!requireNamespace("Rfast"))
  install.packages("Rfast")
library(Rfast)

if (!requireNamespace("ggplot2"))
  install.packages("ggplot2")
library(ggplot2)

if (!requireNamespace("plotly"))
  install.packages("plotly")
library(plotly)

# GridFCM
library(devtools)
if (!requireNamespace("GridFCM.practicum"))
  install_github("asanfe/GridFCM.practicum", quietly = TRUE)
library(GridFCM.practicum)

# Viridislilte
if (!requireNamespace("viridisLite"))
  install.packages("viridisLite")
library(viridisLite)

# Test para normalidad multivariante
if (!requireNamespace("MVN"))
  install.packages("MVN")
library(MVN)

if (!requireNamespace("ggpattern", quietly = TRUE))
  install.packages("ggpattern")
library(ggpattern)

if (!requireNamespace("factoextra", quietly = TRUE))
  install.packages("factoextra")
library(factoextra)

if (!requireNamespace("cluster", quietly = TRUE))
  install.packages("cluster")
library(cluster)

if (!requireNamespace("RColorBrewer", quietly = TRUE))
  install.packages("RColorBrewer")
library(RColorBrewer)

if (!requireNamespace("rcartocolor", quietly = TRUE))
  install.packages("rcartocolor")
library(rcartocolor)

if (!requireNamespace("dplyr", quietly = TRUE))
  install.packages("dplyr")
library(dplyr)

2 Importación y resumen

2.1 Importación del objeto RDA

# Objetos de sesión de ejemplo de la PEC
path <- '../CentralityTest/data.RData'
load(path)
sample.raw.df <- data

sample.df <- data.frame(ID = sample.raw.df$dataset$ID,
                         gender = sample.raw.df$dataset$gender,
                         age = sample.raw.df$dataset$age,
                         edu = sample.raw.df$dataset$edu,
                         status = "Error")

for(i in 1:nrow(sample.df)) {
  id <- sample.df$ID[i]  
  
  tryCatch({
    wimp <- data$grids[[id]]$WT  # Accede al wimp asociado al ID
    wphm <- GridFCM.practicum::ph_index(wimp = wimp, method = "wnorm", std = "none")

    sample.df$status[i] <- "Ok"
  }, error = function(e){
    cat("Error procesando ID:", id, "\n")
  })
}
## Error procesando ID: P0166567 
## Error procesando ID: P0512115 
## Error procesando ID: P0606903 
## Error procesando ID: P0666512 
## Error procesando ID: P0870223 
## Error procesando ID: P0910424 
## Error procesando ID: P1102149 
## Error procesando ID: P1123165 
## Error procesando ID: P1140623 
## Error procesando ID: P1312902 
## Error procesando ID: P1426704 
## Error procesando ID: P1554581 
## Error procesando ID: P1891931 
## Error procesando ID: P1933446
# Calcula las frecuencias de status de procesamiento
freqs.status <- table(sample.df$status, useNA = "no")

# Calcula los porcentajes
percent.status <- prop.table(freqs.status) * 100

results.summary <- data.frame(
  ResultadoCarga = names(freqs.status),
  Casos = as.integer(freqs.status),
  Porcentaje = round(100 * prop.table(freqs.status), 3)
)

results.summary <- results.summary[, c("ResultadoCarga", "Casos", "Porcentaje.Freq")]

2.2 Resultado de procesamiento

# Mostrar la tabla
DT::datatable(results.summary, options = list(pageLength = 5))

2.3 Resumen de sujetos

DT::datatable(sample.df)

2.3.1 Conjunto de constructos global

# Crear un data frame para almacenar los resultados
sample.contructs.df <- data.frame(ID = character(), P = numeric(), H = numeric(), m_dist = numeric(), hub = logical())

for(i in 1:nrow(sample.df)) {
  id <- sample.df$ID[i] 
  
  tryCatch({
    wimp <- data$grids[[id]]$WT  # Accede al wimp usando el ID
    wimpRT <- data$grids[[id]]$WR  # Accede al wimp usando el ID
    wphm <- GridFCM.practicum::ph_index(wimp = wimp, method = "wnorm", std = "none")
    wphmRT <- GridFCM.practicum::ph_index(wimp = wimpRT, method = "wnorm", std = "none")
    
    #-------------------
    # Test. Convertir los resultados a un data frame y añadir el ID
    indv.obs.df <- as.data.frame(wphm)
    indv.obs.df$ID <- id

    #--------------------------------
    # Convertir los resultados a un data frame y añadir el ID
    indv.obs.RT.df <- as.data.frame(wphmRT)
    indv.obs.RT.df$ID <- id

    # Incorporaremos columnas p y h del test y del retest
    obs.columns <- indv.obs.df[, c("ID", "p", "h")]
    rt.columns <- indv.obs.RT.df[, c("p", "h")]

    # Nombres de las columnas p y h en retest
    names(rt.columns) <- c("p.RT", "h.RT")

    # Combinamos las columnas en un solo DF
    combined.row <- cbind(obs.columns, rt.columns)
    
    # Añadimos la fila
    sample.contructs.df <- rbind(sample.contructs.df, combined.row)
  }, error = function(e){
  })
}

DT::datatable(sample.contructs.df)

2.4 Wimp del sujeto a presentar

# Selección de un sujeto
id.obs <- params$id.sujeto.entrada
wimp <- sample.raw.df$grids[[id.obs]]$WT
sujeto.df <- sample.raw.df$dataset[data$dataset$ID == id.obs,]

bertin(wimp$openrepgrid, colors = c("palegreen", "darkgreen"))

3 Exploración de la Wimp

3.1 Digrafo del Self

# Digraph
GridFCM.practicum::digraph(wimp, layout = "rtcircle")

3.2 Digrafo del Ideal

# Digraph
GridFCM.practicum::idealdigraph(wimp, layout = "rtcircle")

3.3 E/S de los constructos. Método Simple

c.io.test <- GridFCM.practicum::degree_index(wimp, method = "simple")
c.io.test <- c.io.test[, c(2,1,3)]
c.io.test <- cbind(c.io.test, Diff = (c.io.test[, 2] - c.io.test[, 1]))
c.io.test.r <- round(c.io.test, 3)
DT::datatable(c.io.test.r)

3.4 E/S de los constructos. Método wnorm

c.io.test <- GridFCM.practicum::degree_index(wimp, method = "wnorm")
c.io.test <- c.io.test[, c(2,1,3)]
c.io.test <- cbind(c.io.test, Diff = (c.io.test[, 2] - c.io.test[, 1]))
c.io.test.r <- round(c.io.test, 3)
DT::datatable(c.io.test.r)

3.5 Ejemplo de salida de P-H index

test.wphm <- GridFCM.practicum::ph_index(wimp = wimp, method = "wnorm", std = FALSE)
DT::datatable(test.wphm)

4 Distancia de Mahalanobis y distribución de datos

4.1 Test de Mardia para análisis multivariante

Llevamos a cabo previamente un test de Mardia para constrastar la normalidad multivariante de los datos, a fin de determinar la pertinencia del punto de corte basado en adecuación a distribución Chi-cuadrado de distancia de Mahalanobis

# Test de Mardia

test.result <- mvn(data = test.wphm, mvnTest = "mardia")

print(test.result)
## $multivariateNormality
##              Test          Statistic           p value Result
## 1 Mardia Skewness   5.94432952324576 0.203344532215649    YES
## 2 Mardia Kurtosis -0.632059343195372 0.527348100686439    YES
## 3             MVN               <NA>              <NA>    YES
## 
## $univariateNormality
##               Test  Variable Statistic   p value Normality
## 1 Anderson-Darling     p        0.2226    0.7632    YES   
## 2 Anderson-Darling     h        0.4194    0.2607    YES   
## 
## $Descriptives
##    n          Mean    Std.Dev      Median        Min       Max        25th
## p 10  3.535534e-01 0.13849326  0.33391154  0.1453497 0.5578287  0.28480690
## h 10 -6.952446e-19 0.09610023 -0.02357023 -0.1060660 0.2160604 -0.05106882
##         75th        Skew   Kurtosis
## p 0.46551196 -0.04114786 -1.4431643
## h 0.03437325  0.91578990 -0.1180833

4.2 Test de resultado de la función

test.wmahalanobis <- GridFCM.practicum::mahalanobis_index(wimp = wimp, method = "wnorm", std = FALSE, sign.level = 0.2)
DT::datatable(test.wmahalanobis)

4.3 Distribución Chi-cuadrado

# Definimos los grados de libertad para la distribución chi-cuadrado
df <- 2

# Generamos los valores de la distribución
x <- seq(qchisq(0.001, df), qchisq(0.999, df), length.out = 1000)
y <- dchisq(x, df)

# Calculamos los puntos de corte para el 20% superior
sign.level <- 0.2
cut_high <- qchisq(1- sign.level, df)

# Dataframe para la gráfica
data <- data.frame(x = x, y = y)

ggplot(data, aes(x = x, y = y)) + 
  geom_line() + 
  geom_ribbon(data = data %>% filter(x > cut_high), aes(ymax = y), ymin = 0, fill = 'salmon', alpha = 0.5) +
  geom_vline(xintercept = cut_high, color = "red", linetype = "dashed") +
  labs(title = 'Distribución Chi-cuadrado con puntos de corte del 80%', x = 'Valor', y = 'Densidad') +
  theme_minimal()

4.4 Gráfica de barras de distancias de Mahalanobis y punto de corte

# Distancia de Mahalanobis
test.bp.wmahalanobis <- GridFCM.practicum::mahalanobis_index(wimp = wimp, method = "wnorm", std = FALSE)
test.wmahalanobis.df <- as.data.frame(test.bp.wmahalanobis)

# Colores de los constructos


#test.wmahalanobis.df$constructo <- rownames(test.wmahalanobis)
test.wmahalanobis.df$constructo <- wimp$constructs$left.poles

# Valoración del ideal
test.wmahalanobis.df$idealdirect <- wimp$ideal$direct

# Columna para identificar constructos dilemáticos
#test.wmahalanobis.df$fill.color <- ifelse(test.wmahalanobis.df$idealdirect == 4, "yellow2", "honeydew")
test.wmahalanobis.df$fill.color <- construct_colors(wimp= wimp, mode = "red/green")

# Ordenamos las barras en orden decreciente
test.wmahalanobis.df <- test.wmahalanobis.df %>%
  arrange(desc(m.dist))

# Convertimos 'constructo' en un factor con los niveles en el orden deseado
test.wmahalanobis.df$constructo <- factor(test.wmahalanobis.df$constructo, levels = test.wmahalanobis.df$constructo)

# Punto de corte distribución Chi-Cuadrado
sign.level <- 0.2
df <- ncol(test.wphm)
chi.square.cutoff <- qchisq(1 - sign.level, df)
#media_m_dist <- mean(test.wmahalanobis.df$m.dist)

4.5 Constructos supraordenados

# Crear el histograma de constructos supraordenados

# Filtramos por los constructos donde el valor de 'h' es mayor que cero
test.wmahalanobis.df.sup <- test.wmahalanobis.df %>%
  filter(h > 0)

bar_plot <- ggplot(test.wmahalanobis.df.sup, aes(x = constructo, y = m.dist, fill = fill.color)) +
  geom_bar(stat = "identity", color = "black", linewidth = 0.25) +
  geom_hline(yintercept = chi.square.cutoff, linetype = "dashed", color = "darkgreen", linewidth = 1) +
  scale_fill_identity() + # Usa los colores asignados directamente
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    legend.position = "none" 
  ) +
  labs(x = "Constructos con h > 0", y = "Distancia de Mahalanobis", title = "Constructos con h>0 por distancia de Mahalanobis")

# Mostramos el gráfico
print(bar_plot)

4.6 Constructos subordinados

# Crear el histograma de constructos subordinados

# Filtramos por los constructos donde el valor de 'h' es menor que cero
test.wmahalanobis.df.sub <- test.wmahalanobis.df %>%
  filter(h < 0)

bar_plot <- ggplot(test.wmahalanobis.df.sub, aes(x = constructo, y = m.dist, fill = fill.color)) +
  geom_bar(stat = "identity", color = "black", linewidth = 0.25) +
  geom_hline(yintercept = chi.square.cutoff, linetype = "dashed", color = "darkgreen", linewidth = 1) +
  scale_fill_identity() + # Usa los colores asignados directamente
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    legend.position = "none" 
  ) +
  labs(x = "Constructos con h < 0", y = "Distancia de Mahalanobis", title = "Constructos con h<0 por distancia de Mahalanobis")

# Mostramos el gráfico
print(bar_plot)

4.7 Distribución de valores en P

4.7.1 Distribución de valores de P

# Crear el histograma de valores en P

test.wmahalanobis.df.sortP <- test.wmahalanobis.df %>% 
  arrange(desc(p))

mean.p <- mean(abs(test.wmahalanobis.df.sortP$p))

# Convertir 'constructo' en un factor para mantener el orden en el gráfico
test.wmahalanobis.df.sortP$constructo <- factor(test.wmahalanobis.df.sortP$constructo, 
                                          levels = test.wmahalanobis.df.sortP$constructo)

bar_plot <- ggplot(test.wmahalanobis.df.sortP, aes(x = constructo, y = p, fill = fill.color)) +
  geom_bar(stat = "identity", color = "black", linewidth = 0.25) +
  geom_hline(yintercept = mean.p, linetype = "dashed", color = "darkgreen", linewidth = 1) +
  scale_fill_identity() + # Usa los colores asignados directamente
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    legend.position = "none" 
  ) +
  labs(x = "Constructos", y = "Valor de P", title = "Constructos por distancia en P")

# Mostramos el gráfico
print(bar_plot)

4.7.2 Test Shapiro-Wilk (muestras pequeñas o moderadas) para variable P

# Test de normalidad de Saphiro-Wilk
norm.test <- shapiro.test(test.wmahalanobis.df$p)

# Imprime el resultado
print(norm.test)
## 
##  Shapiro-Wilk normality test
## 
## data:  test.wmahalanobis.df$p
## W = 0.95378, p-value = 0.7133
p.value <- 0.05
norm.test.result <- norm.test$p.value > p.value 

De acuerdo con el resultado de la prueba, la normalidad de la distribución de los valores de P es: TRUE

4.7.3 Gráfica Cuantil-Cuantil

datos <- test.wmahalanobis.df$p

# Gráfica q-q para comprobar la normalidad
qqnorm(datos)
qqline(datos, col = "red")

4.7.4 Punto de corte basado en distribución normal de P

# Media y desviación típica de la distribución
mean.p <- mean(test.wmahalanobis.df$p)
sd.p <- sd(test.wmahalanobis.df$p)

# Definir el rango de valores para X basado en la media y desviación típica
x.values <- seq(from = mean.p - 4 * sd.p, to = mean.p + 4 * sd.p, length.out = 1000)

# Crear un dataframe con los valores de X y la densidad de una distribución normal para esos valores
norm.df <- data.frame(x = x.values, y = dnorm(x.values, mean = mean.p, sd = sd.p))

# Punto de corte
cut.low <- qnorm(0.15, mean = mean.p, sd = sd.p)

plot <- ggplot(norm.df, aes(x = x, y = y)) +
  geom_line() +
  geom_vline(xintercept = cut.low, linetype = "dashed", color = "red", linewidth = 1) +
  geom_vline(xintercept = mean.p, linetype = "dashed", color = "blue", linewidth = 1) +
  geom_area(data = subset(norm.df, x <= cut.low), fill = "lightblue", alpha = 0.2) +
  theme_bw() +
  theme(
    panel.grid.major = element_line(linewidth = 0.5, linetype = 'solid', colour = "lightgrey"),
    panel.grid.minor = element_blank(),
    legend.position = "none"
  ) +
  scale_x_continuous(name = "Valor de P") +
  scale_y_continuous(name = "Densidad") +
  labs(title = paste("Distribución Normal con Media en", round(mean.p, 2),
                     "y Punto de Corte en", round(cut.low, 2)))
# Mostrar la gráfica
print(plot)

5 Centralidad y orden subjetivo de los constructos

# Crear una nueva columna para almacenar el valor de importancia en test.wmahalanobis.df
test.wmahalanobis.df$importanciaSubjetiva <- NA
test.wmahalanobis.df$totalCentrl <- NA

# Asignar el valor de cen.ord.cX.test basado en el número de fila
for (i in 1:nrow(test.wmahalanobis.df)) {
  constructo.actual <- test.wmahalanobis.df$constructo[i]
  
  # Buscar este constructo en 'sujeto.df' desde c1l a c10l
  for (j in 1:10) {
    col.constructo <- paste("c", j, "l", sep = "")
    col.importanciaSub <- paste("cen.ord.c", j, ".test", sep = "")
    col.totalCentrl <- paste("cen.c", j, ".test", sep = "")
    
    if (constructo.actual %in% sujeto.df[[col.constructo]]) {
      # Si el constructo se encuentra, asignar la importancia subjetiva correspondiente
      test.wmahalanobis.df$importanciaSubjetiva[i] <- sujeto.df[[col.importanciaSub]]
      test.wmahalanobis.df$totalCentrl[i] <- sujeto.df[[col.totalCentrl]]
      break  # Salir del bucle interno una vez que se asigna el valor
    }
  }
}

DT::datatable(select(test.wmahalanobis.df, p, h, m.dist, hub, importanciaSubjetiva, totalCentrl))

6 Representación en espacio P-H

6.1 Sin estandarización - plotly sin marcar área no viable ni constructos centrales

wp1.grph <- GridFCM.practicum::graph_ph(wimp = wimp, method = "wnorm", std = 'none', sign.level = 0.2,
                                        mark.nva = FALSE, mark.hub = FALSE)
wp1.grph

6.2 Espacio PH con coloreado de área no útil y marcado de outliers. Función de representación

6.2.1 Sin estandarización

wp1.grph <- GridFCM.practicum::graph_ph(wimp = wimp, method = "wnorm", std = 'none', sign.level = 0.2,
                                        mark.nva = TRUE, mark.hub = TRUE, show.points = TRUE)
wp1.grph

6.2.2 Con estandarización basada en aristas

wp1.grph <- GridFCM.practicum::graph_ph(wimp = wimp, method = "wnorm", std = 'edges', sign.level = 0.2,
                                        mark.nva = TRUE, mark.hub = TRUE, show.points = TRUE)
wp1.grph

6.2.3 Sin estandarización, marcando área de coordenadas no viables. Sin puntos

wp1.grph <- GridFCM.practicum::graph_ph(wimp = wimp, method = "wnorm", std = "none", sign.level = 0.2,
                                        mark.nva = TRUE, mark.hub = TRUE, show.points = FALSE)
wp1.grph
## No trace type specified:
##   Based on info supplied, a 'scatter' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter
## No scatter mode specifed:
##   Setting the mode to markers
##   Read more about this attribute -> https://plotly.com/r/reference/#scatter-mode

6.2.4 Sin estandarización, sin marcar área de coordenadas no viables. Sin puntos

wp1.grph <- GridFCM.practicum::graph_ph(wimp = wimp, method = "wnorm", std = "none", sign.level = 0.2,
                                        mark.nva = FALSE, mark.hub = TRUE)

wp1.grph

7 Otros métodos de centralidad

7.1 Centralidad sobre caso individual de estudio

7.1.1 Eigenvectores sobre matriz de implicaciones

La puntuación de centralidad para cada constructo se obtiene sumando los cuadrados de las componentes de los n primeros vectores propios, ponderados por los respectivos valores propios. Este vector de puntuciones representa cuánto contribuye cada constructo a las n principales dimensiones de variabilidad en los datos.

# Invocamos la función utilizando la matriz de implicaciones, y los dos primeros vectores propios
cent.evalues.df <- GridFCM.practicum::eigen_index(wimp = wimp, matrix = "weights", num.vectors = 2)
DT::datatable(cent.evalues.df)

7.1.2 Análisis de componentes principales (PCA)

7.1.2.1 Resultado de cálculo de centralidad

La siguiente función calcula la centralidad de los constructos utilizando un PCA aplicado a la matriz de implicaciones. Se calcula la varianza explicada por cada componente principal y se usa para ponderar las cargas de los dos primeros componentes. La centralidad de cada constructo se determina sumando las cargas cuadradas de los n primeros componentes principales (valor indicado como parámetro), ponderadas por la varianza explicada por estos componentes.

# Invocamos la función utilizando la matriz de implicaciones, y los dos primeros constructos principales
cent.pcavalues.df <- GridFCM.practicum::pca_index(wimp = wimp, matrix = "weights", pr.comp = 2)
DT::datatable(cent.pcavalues.df)

7.1.2.2 PCA Plot

# Foco del PCA
adj.matrix <- wimp$scores$weights

# Análisis de componentes principales
pca.result <- prcomp(adj.matrix, center = TRUE, scale = TRUE)

# Extraer los dos primeros componentes principales
pca.comp <- as.data.frame(pca.result$x[, 1:2])
pca.comp$constructs <- wimp$constructs$constructs

# Crea la gráfica de dispersión
pca.plot <- plot_ly(data = pca.comp, x = ~PC1, y = ~PC2, type = 'scatter', mode = 'markers',
                    hoverinfo = 'text+x+y',
                    marker = list(size = 10, opacity = 0.8)) %>%
            layout(title = 'PCA de matriz de adyacencia',
                   xaxis = list(title = 'PCA 1'),
                   yaxis = list(title = 'PCA 2'),
                   hovermode = 'closest',
                   plot_bgcolor = "white",
                   font = list(family = "Arial"),
                   showlegend = FALSE) %>%
            # Add annotations for each point
            add_annotations(data = pca.comp, x = ~PC1, y = ~PC2, text = ~constructs,
                            showarrow = FALSE, xanchor = 'center', yanchor = 'bottom', font = list(size = 12))

# Muestra la gráfica
pca.plot

7.2 Comparativa de métodos de centralidad

7.2.1 Definición de función

Utilizaremos la siguiente función para poder establecer una comparativa entre los tres métodos de centralidad trabajados:

  • Distancia de Mahalanobis con marcado de constructos “hub”
  • Vectores propios sobre matriz de pesos de rejilla de implicaciones ponderada
  • Análisis de componentes principales sobre matriz de pesos de rejilla de implicaciones ponderada

Invocaremos la función tanto para el caso actual de estudio, como para el conjunto de observaciones global con el que estamos trabajando.

# Función que devuelve un dataframe de comparativa de métodos de centralidad, para un identificador de caso del conjunto de observaciones disponible. La función acepta un parámetro de selección de casos de Test o de Retest

centrality.comp <- function(id.obs, selection = "WT"){
  
  # Recupera el dataset asociado a la información general y de infomación de autoevaluación de importancia subjetiva de constructos
  obs.id.df <- sample.raw.df$dataset[sample.raw.df$dataset$ID == id.obs,]
  # Recupera el wimp de la muestra, para Test o pra Retest según el parámetro de selección
  obs.wimp <- sample.raw.df$grids[[id.obs]][[selection]]
  
  # Cálculo de medidas de centralidad sobre el caso. Basaremos el cálculo en la matriz de pesos, y
  # dos vectores propios para eigen_index / dos componentes principales para pca_index
  mahalanobis.res.lst <- mahalanobis_index(obs.wimp)
  eigen.res <- GridFCM.practicum::eigen_index(wimp = obs.wimp, matrix = "weights", num.vectors = 2)
  pca.res <- GridFCM.practicum::pca_index(wimp = obs.wimp, matrix = "weights", pr.comp = 2)
  
  mahalanobis.res <- as.data.frame(mahalanobis.res.lst)
  mahalanobis.res$constructs <- rownames(mahalanobis.res)
  
  # Conjunto de constructos que combina los métodos de centralidad
  unq.constructs <- unique(c(mahalanobis.res$constructs, eigen.res$constructs, pca.res$constructs))
  
  # Dataframe con combinación de las medidas
  comb.df <- data.frame(constructs = unq.constructs)
  
  comb.df <- merge(comb.df, mahalanobis.res[, c("constructs", "m.dist")], by = "constructs", all.x = TRUE)
  comb.df <- merge(comb.df, eigen.res[, c("constructs", "centrality")], by = "constructs", all.x = TRUE,
                   suffixes = c(".mahalanobis", ".eigen"))
  comb.df <- merge(comb.df, pca.res[, c("constructs", "centrality")], by = "constructs", all.x = TRUE)
  
  # Redondea las columnas numéricas a 3 decimales
  comb.df <- comb.df %>%
    mutate(across(where(is.numeric), round, digits = 3))
  
  # Renombramos columnas
  names(comb.df)[2:4] <- c("Centr_Mahalanobis", "Centr_Eigen", "Centr_PCA")
  
  # Ranking de los constructos dentro de cada método
  comb.df$Rank_Mahalanobis <- rank(-comb.df$Centr_Mahalanobis, ties.method = "first")
  comb.df$Rank_Eigen <- rank(-comb.df$Centr_Eigen, ties.method = "first")
  comb.df$Rank_PCA <- rank(-comb.df$Centr_PCA, ties.method = "first")
  
  comb.df <- comb.df[order(comb.df$Rank_Mahalanobis),]
  
  # Medidas subjetivas de centralidad
  mahalanobis.res$importanciaSubjetiva <- NA
  mahalanobis.res$totalCentrl <- NA
  
  for (i in 1:nrow(mahalanobis.res)) {
    mahalanobis.res$importanciaSubjetiva[i] <- obs.id.df[[paste("cen.ord.c", i, ".test", sep = "")]]
    mahalanobis.res$totalCentrl[i] <- obs.id.df[[paste("cen.c", i, ".test", sep = "")]]
  }
  
  # Dataframe combinado para resultados
  centrality.comb.df <- merge(mahalanobis.res, comb.df, by = "constructs", all = TRUE)
  centrality.comb.df$ID <- id.obs
  
  # Redondea las columnas numéricas a 3 decimales
  centrality.comb.pres.df <- centrality.comb.df %>%
    mutate(across(where(is.numeric), round, digits = 3))
  
  return(centrality.comb.pres.df)
}

7.2.2 Comparativa aplicada a caso individual de estudio

7.2.2.1 Comparativa para medidas de Test

test.result <- centrality.comp(id.obs, "WT")

# Mostrar o manipular el dataframe global según sea necesario
DT::datatable(test.result)

7.2.2.2 Correlaciones de medidas de centralidad.Test

Para las medidas de correlación, en adelante, partiremos de las siguientes premisas:

  • Omitiremos las observaciones en las que existan datos faltantes. Pueden presentarse datos faltantes, por ejemplo, en aquellos constructos en los que no se haya podido calcular la centralidad basada en PCA
  • Emplearemos el método de Kendall (Tau-b), no paramétrico, para las correlaciones calculadas. Procedemos de este modo en la media en que:
    • No asumimos normalidad de los datos
    • Contamos con una muestra pequeña/media de datos
    • Los datos cuentan con outliers, circunstancia a la que es menos sensible el método Kendall, frente al de Spearman o el de Pearson
corr.sel <- round(cor(test.result[c("p", "h", "importanciaSubjetiva", "totalCentrl", "Rank_Eigen", "Rank_PCA",
                                           "Rank_Mahalanobis")],
                  use = "complete.obs", method = "kendall"), 3)

DT::datatable(corr.sel)

7.2.2.3 Comparativa para medidas de Retest

test.result <- centrality.comp(id.obs, "WR")

# Mostrar o manipular el dataframe global según sea necesario
DT::datatable(test.result)

7.2.2.4 Correlaciones de medidas de centralidad. Retest

corr.sel <- round(cor(test.result[c("p", "h", "importanciaSubjetiva", "totalCentrl", "Rank_Eigen", "Rank_PCA",
                                           "Rank_Mahalanobis")],
                  use = "complete.obs", method = "kendall"), 3)

DT::datatable(corr.sel)

7.2.3 Comparativa aplicada a todas las observaciones

7.2.3.1 Comparativa para medidas de Test

# Aplicamos centrality.comp a cada ID y almacenamos los resultados en una lista
results.lst <- lapply(sample.df$ID, function(id) {
  tryCatch({
    # Intentar ejecutar centrality.comp y agregar la columna ID
    temp.result <- centrality.comp(id, "WT")
    temp.result$ID <- id  # Agregar la columna ID
    return(temp.result)  # Devolver el resultado
  }, error = function(e) {
    # En caso de error, devolver un dataframe vacío
    message("Error procesando ID:", id, "; Error: ", e$message)
    return(data.frame())
  })
})
## Error procesando ID:P0154621; Error: replacement has length zero
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P0166567; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P0512115; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P0606903; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P0666512; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P0870223; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P0910424; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P1102149; Error: non-numeric argument to mathematical function
## Error procesando ID:P1123165; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P1140623; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P1312902; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P1426704; Error: non-numeric argument to mathematical function
## Error procesando ID:P1542321; Error: Lapack routine dgesv: system is exactly singular: U[1,1] = 0
## Error procesando ID:P1554581; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P1891931; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P1933446; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
# Combinar todos los dataframes de la lista en un solo dataframe
global.centrality.test.df <- do.call(rbind, results.lst)

# Mostrar o manipular el dataframe global según sea necesario
DT::datatable(global.centrality.test.df)

7.2.3.2 Correlaciones entre las medidas generales de centralidad. Test

corr.sel <- round(cor(global.centrality.test.df[c("p", "h", "importanciaSubjetiva", "totalCentrl", "Rank_Eigen", "Rank_PCA",
                                           "Rank_Mahalanobis")],
                  use = "complete.obs", method = "kendall"), 3)

DT::datatable(corr.sel)

7.2.3.3 Comparativa para medidas de Retest

# Aplicamos centrality.comp a cada ID y almacenamos los resultados en una lista
results.lst <- lapply(sample.df$ID, function(id) {
  tryCatch({
    # Intentar ejecutar centrality.comp y agregar la columna ID
    temp.result <- centrality.comp(id, "WR")
    temp.result$ID <- id  # Agregar la columna ID
    return(temp.result)  # Devolver el resultado
  }, error = function(e) {
    # En caso de error, devolver un dataframe vacío
    message("Error procesando ID:", id, "; Error: ", e$message)
    return(data.frame())
  })
})
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P0154621; Error: replacement has length zero
## Error procesando ID:P0166567; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P0512115; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P0606903; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P0666512; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P0870223; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P0910424; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P1102149; Error: non-numeric argument to mathematical function
## Error procesando ID:P1123165; Error: non-numeric argument to mathematical function
## Error procesando ID:P1140623; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P1312902; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P1426704; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P1542321; Error: Lapack routine dgesv: system is exactly singular: U[1,1] = 0
## Error procesando ID:P1554581; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P1891931; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
## Error procesando ID:P1933446; Error: non-numeric argument to mathematical function
## Error en el cálculo del PCA: cannot rescale a constant/zero column to unit variance
# Combinar todos los dataframes de la lista en un solo dataframe
global.centrality.retest.df <- do.call(rbind, results.lst)

# Mostrar o manipular el dataframe global según sea necesario
DT::datatable(global.centrality.retest.df)

7.2.3.4 Correlaciones entre las medidas generales de centralidad. Retest

corr.sel <- round(cor(global.centrality.retest.df[c("p", "h", "importanciaSubjetiva", "totalCentrl", "Rank_Eigen", "Rank_PCA",
                                           "Rank_Mahalanobis")],
                  use = "complete.obs", method = "kendall"), 3)

DT::datatable(corr.sel)

8 Análisis por conglomerados

8.1 Determinación de número óptimo de conglomerados

El cálculo se basará en la distancia de Mahalanobis entre pares de puntos. La distancia de Mahalanobis se calcula utilizando la fórmula:

\[d(\mathbf{x}, \mathbf{y}) = \sqrt{(\mathbf{x} - \mathbf{y})^T \mathbf{S}^{-1} (\mathbf{x} - \mathbf{y})}\]

Donde:

  • \(\mathbf{x}\) y \(\mathbf{y}\) son los dos vectores que representan los dos puntos en el espacio.
  • \(\mathbf{S}^{-1}\) es la matriz inversa de la matriz de covarianza de los datos.
k <- test_optimal_num_clusters(wimp = wimp, method = "wnorm", std = "none")
k
## [1] 4

Tenemos un número máximo de 4 conglomerados en nuestros datos.

8.2 Representación de números de conglomerados óptimo

Adecuación de cohesión y separación de cada punto según pertenezca a distintos conglomerados:

# Lista que albergará las distintas gráficas de silueta
lista.graf.sil <- list()

# Valores intermedios que ya calcula .optimal.num.clusters
max.clusters <- length(wimp$constructs$constructs) - 1
ph.mat <- GridFCM.practicum::ph_index(wimp = wimp, method = "wnorm", std = "none")
#rownames(test.dist) <- as.character(wimp$constructs$right.poles)
#distancias <- dist(test.dist, method = "euclidean")

#------------------------------
# Matriz de disimilaridad modelada como matriz de distancias de Mahalanobis
# Matriz de covarianzas
cov.matrix <- cov(ph.mat)  # Calcula la matriz de covarianza
# Vector de medias
means.vector <- colMeans(ph.mat)

# Inicializa una matriz para guardar las distancias de Mahalanobis
n <- nrow(ph.mat)
dist.mat <- matrix(NA, n, n)

# Calcula la distancia de Mahalanobis entre cada par de filas en ph.mat
for (i in 1:n) {
  for (j in i:n) {
    diff <- ph.mat[i, ] - ph.mat[j, ]
    dist.mat[i, j] <- sqrt(t(diff) %*% solve(cov.matrix) %*% diff)
    dist.mat[j, i] <- dist.mat[i, j]  # La matriz es simétrica
  }
}

# Hacemos 0 en la diagonal
diag(dist.mat) <- 0

row.names(dist.mat) <- row.names(ph.mat)
colnames(dist.mat) <- row.names(ph.mat)

#---------------------------

# Preparamos una lista con diversas representaciones gráficas de siluetas (de 2 a 10 clústeres)
for(j in 2:min(13, max.clusters)){
  it.pam <- cluster::pam(dist.mat, j, diss = TRUE)
  p <- factoextra::fviz_silhouette(it.pam, label = FALSE, print.summary = FALSE)
  lista.graf.sil[[j-1]] <- p
}

# Organizar los gráficos en una matriz de 4x3, y los presentamos
gridExtra::grid.arrange(grobs = lista.graf.sil, ncol = 3, nrow = 4)

8.2.1 Dendrograma

#Dendrograma
dendron.plot <- constructs_dendrogram(wimp = wimp)
## Registered S3 method overwritten by 'dendextend':
##   method       from   
##   text.pvclust pvclust
print(dendron.plot)

8.2.2 ClusPlot

act.cex <- par("cex")
par(cex = 0.8)

# Calculamos el objeto de partición PAM para los k clústeres obtenidos anteriormente
opt.pam <- cluster::pam(dist.mat, k, diss = TRUE)

# Colores de los clusters
clus.colors <- carto_pal(n = k, "Peach")

cluster::clusplot(x = dist.mat,
                  clus = opt.pam$clustering,
                  shade = TRUE,
                  color = TRUE,
                  col.clus = clus.colors,
                  col.p = 'darkblue',
                  diss = TRUE,
                  labels = 3)